home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / comm / www / 1stLinkChecker.lha / 1st_LinkChecker / ExtLinkChecker next >
Text File  |  1997-08-08  |  4KB  |  165 lines
  1. /* Optimized with RexxOpt 1.7 */
  2.  
  3. NL='0A'X
  4. TempFile="ram:HTMLfound"
  5. say "***************************************************"
  6. say "* External Link Checker V1.3 (08/07/97)           *"
  7. say "* © Heiko Schröder (age@thepentagon.com)          *"
  8. say "***************************************************"||NL
  9. Ports=Show('P')
  10. Parse Var Ports dummy 'AWEB.' portnr .
  11. If portnr='' then;do
  12. say "I cant check external links if AWEB isn't running!"
  13. say "Please start AWEB."
  14. Call Fini
  15. end
  16. if ~show('L',"rexxreqtools.library") then;do
  17. if ~addlib('rexxreqtools.library',0,-30,0) then;do
  18. say "You need LIBS:rexxreqtools.library. Cancel"
  19. Call Fini
  20. END
  21. END
  22. verz=GetClip("xdir")
  23. dir=rtfilerequest(verz,,"Where can I search? Pick Dir and OK",,"rtfi_flags = freqf_nofiles")
  24. if rtresult=0 then;do
  25. echo "Cancel"
  26. Exit
  27. End
  28. pat="PAT=#?.#?(htm|html)"
  29. say "Checking: "||dir
  30. void=SetClip("xdir",dir)
  31. directory=dir
  32. if dir~="" then dir=d2c(34)||dir||d2c(34)
  33. address command "list >"TempFile dir pat||" quick nohead files all lformat %s%s"
  34. Time('R')
  35. Datei=0;Fehler=0;Links=0
  36. Open("LCR","T:LinkCheckResult","W")
  37. Open("HTML",TempFile,"R")
  38. DO WHILE 1
  39. htmlfile=ReadLn('HTML')
  40. IF EOF('HTML') THEN leave
  41. Datei=Datei+1
  42. ende=0
  43. zeile=0
  44. say d2c(11)||copies(" ",70)||d2c(11)
  45. say "Checking: "DelStr(htmlfile,1,length(directory))
  46. say "Files: "||Datei||" - Links: "||links||" - Errors: "||Fehler||""d2c(11)
  47. Open("CHECK",htmlfile,"R")
  48. DO WHILE ende=0
  49. Do WHILE ende=0
  50. line=Readln('CHECK')
  51. IF EOF('CHECK') THEN ende=1
  52. zeile=zeile+1
  53. DO WHILE 1
  54. pos11=pos('SRC=',upper(line));if pos11=0 then pos11=99999
  55. pos12=pos('HREF=',upper(line));if pos12=0 then pos12=99999
  56. pos1=min(pos11,pos12)
  57. IF pos1=99999 then leave
  58. pos13=min(pos('=',line,pos1),pos('="',line,pos1))
  59. Select
  60. When pos13=0 then pos1=pos('=',line,pos1)
  61. When pos13<pos1+7 then pos1=pos13
  62. Otherwise NOP
  63. End
  64. pos21=pos(d2c(34),line,pos1+2);if pos21=0 then pos21=99999
  65. pos22=pos(" ",line,pos1+2);if pos22=0 then pos22=99999
  66. pos23=pos("#",line,pos1+2);if pos23=0 then pos23=99999
  67. pos24=pos(">",line,pos1+2);if pos24=0 then pos24=99999
  68. pos2=min(pos21,pos22,pos23,pos24)
  69. IF pos2=99999 then leave
  70. link=left(line,pos2-1)
  71. line=Delstr(line,1,pos2+1)
  72. link=DelStr(link,1,pos1)
  73. link=strip(link,B,d2c(34))
  74. link=strip(link,B,"=")
  75. retrieve=1
  76. outlink=0
  77. if pos("HTTP://",upper(link)) ~=0 then outlink=1
  78. if pos("FTP://",upper(link)) ~=0 then outlink=1
  79. if pos("GOPHER://",upper(link)) ~=0 then outlink=1
  80. if pos("ABOUT:",upper(link)) ~=0 then outlink=1
  81. if outlink=1 then;do
  82. address value 'AWEB.'||portnr
  83. Open link
  84. Wait Doc
  85. SaveAs "T:LinkChecker.tmp"
  86. address 'REXX'
  87. Open("TMP","T:LinkChecker.tmp","R")
  88. extline=readln('TMP')
  89. Close("TMP")
  90. IF pos("<HTML><H1>ERROR</H1>",upper(extline))~=0 then retrieve=0
  91. end
  92. else;do
  93. leave
  94. end
  95. links=links+1
  96. if retrieve=0 then;do
  97. Fehler=Fehler+1
  98. writeln("LCR",htmlfile||" -> "||link||" -> line: "||zeile)
  99. end
  100. say "Files: "||Datei||" - Links: "||links||" - Errors: "||Fehler||""d2c(11)
  101. END
  102. END
  103. END
  104. Close("CHECK")
  105. END
  106. Close("HTML")
  107. Close("LCR")
  108. Zeit=TIME('E')
  109. address command "delete ram:HTMLfound QUIET"
  110. address command "delete T:LinkChecker.tmp QUIET"
  111. say "Files: "||Datei||" - Links: "||links||" - Errors: "||Fehler||""
  112. If Fehler~=0 then
  113. say "Sorry. There were link errors. They are listed in T:LinkCheckResult."
  114. else
  115. say "Great. No external link errors :-)"
  116. SAY "Elapsed time: "Zeit" sec."
  117. Open("LCR","T:LinkCheckResult","R")
  118. z=0
  119. File.0=Fehler
  120. Link.0=Fehler
  121. Line.0=Fehler
  122. DO WHILE 1
  123. line=ReadLn('LCR')
  124. IF (EOF('LCR')|line='') THEN leave
  125. z=z+1
  126. pos1=pos(" -> ",line)
  127. pos2=pos(" -> ",line,pos1+1)
  128. File.z=Left(line,pos1)
  129. Link.z=Delstr(line,1,pos1+3);Link.z=Left(Link.z,pos2-pos1-4)
  130. Line.z=Delstr(line,1,pos2+9)
  131. End
  132. Close("LCR")
  133. if z=0 then Call Fini
  134. quit=0;del=0;t=1
  135. Do While quit=0
  136. call rtezrequest("Error: "t"/"Fehler||NL||" File: "File.t||NL||" Link: "Link.t||NL||" Line: "Line.t,"Prev|Next|I know|Leave","» Link Errors «",,fonttag "rtez_defaultresponse = 1",result)
  137. if (result=1&t~=1) then t=t-1
  138. if (result=2&t~=z) then t=t+1
  139. if result=3 then del=1
  140. if result=0 then quit=1
  141. if del=1 then;do
  142. if z~=t then;do
  143. do r=t to z-1
  144. e=r+1
  145. File.r=File.e
  146. Link.r=Link.e
  147. Line.r=Line.e
  148. end
  149. end
  150. else;do
  151. r=t-1
  152. t=t-1
  153. end
  154. File.0=r;if r=0 then quit=1
  155. Link.0=r
  156. Line.0=r
  157. z=z-1
  158. Fehler=Fehler-1
  159. del=0
  160. end
  161. End
  162. exit
  163. Fini:
  164. PARSE PULL Keyword
  165. exit